home *** CD-ROM | disk | FTP | other *** search
/ PureBasic (Professional Edition) / NEU.ISO / setup.exe / {app} / Examples / Atomic FTP Server / Atomic FTP Server.pb next >
Text File  |  2002-01-02  |  5KB  |  227 lines
  1. ;
  2. ; ------------------------------------------------------------
  3. ;
  4. ;       Atomic FTP Server in PureBasic by AlphaSND
  5. ;
  6. ;            (c) 2001 - Fantaisie Software
  7. ;
  8. ; ------------------------------------------------------------
  9. ;
  10. ; This program isn't finished, the harder is done but I don't
  11. ; time to implement the whole RFC 959 commands :-).
  12. ; 
  13. ;
  14. ; 01/12/2001
  15. ;   Removed all API call by internal PB functions (much easier)
  16. ;
  17. ; 19/03/2001
  18. ;   Listing is now working.
  19. ;
  20. ; 18/03/2001
  21. ;   Based on the Atomic Web Server code..
  22. ;   First version.
  23. ;
  24.  
  25. If InitNetwork() = 0
  26.   MessageRequester("Error", "Can't initialize the network !", 0) : End
  27. EndIf
  28.  
  29. DefType.l
  30.  
  31. ClientIP.s
  32. Port = 21
  33. BaseDirectory$ = "ftp\"
  34. CurrentDirectory$ = BaseDirectory$
  35. AtomicTitle$   = "Atomic FTP Server v0.1"
  36.  
  37. Global EOL$, ClientID
  38.  
  39. EOL$ = Chr(13)+Chr(10)
  40.  
  41. *Buffer = AllocateMemory(0, 10000 , 0)
  42.  
  43. If CreateNetworkServer(Port)
  44.  
  45.   OpenWindow(0, 100, 200, 230, 0, #PB_Window_SystemMenu, "Atomic FTP Server (Port "+Str(Port)+")")
  46.   
  47.   Repeat
  48.     
  49.     WEvent.l = WindowEvent()
  50.     SEvent.l = NetworkServerEvent()
  51.   
  52.     If WEvent = #PB_EventCloseWindow
  53.       Quit = 1
  54.     EndIf
  55.  
  56.     If SEvent
  57.       ClientID.l = NetworkClientID()
  58.   
  59.       Select SEvent
  60.       
  61.         Case 1  ; New client connected
  62.           a$ = "220 - Atomic FTP Server v0.1 ready"+EOL$
  63.           SendNetworkData(ClientID, @a$, Len(a$))
  64.  
  65.         Case 4  ; New client has closed the connection
  66.   
  67.         Default
  68.           RequestLength.l = ReceiveNetworkData(ClientID, *Buffer, 2000)
  69.           If RequestLength > 3
  70.             PokeL(*Buffer+RequestLength-2, 0)
  71.           EndIf
  72.           Gosub ProcessRequest
  73.           
  74.       EndSelect
  75.     Else
  76.       Delay(20)
  77.     EndIf
  78.     
  79.   Until Quit = 1 
  80.   
  81.   CloseNetworkServer()
  82. Else
  83.   MessageRequester("Error", "Can't create the server (port in use ?).", 0)
  84. EndIf
  85.  
  86. End 
  87.  
  88.  
  89. ProcessRequest:
  90.  
  91.   Command$ = PeekS(*Buffer)
  92.   
  93.   Position = FindString(Command$, " ", 1)
  94.   If Position
  95.     Argument$ = Mid(Command$, Position+1, Len(Command$)-Position)
  96.     Command$ = UCase(StripTrail(Left(Command$, Position-1)))
  97.   EndIf
  98.  
  99.   Select Command$
  100.  
  101.     Case "HELP"
  102.       Gosub Command_HELP
  103.  
  104.     Case "LIST"
  105.       Gosub Command_LIST
  106.  
  107.     Case "PASS"
  108.       Gosub Command_PASS
  109.  
  110.     Case "PORT"
  111.       Gosub Command_PORT
  112.  
  113.     Case "PWD"
  114.       Gosub Command_PWD
  115.  
  116.     Case "SYST"
  117.       Gosub Command_SYST
  118.  
  119.     Case "USER"
  120.       Gosub Command_USER
  121.  
  122.     Default
  123.       Gosub Command_UNKNOWN
  124.  
  125.   EndSelect
  126.  
  127. Return
  128.  
  129.  
  130. Command_HELP:
  131.   a$ = "214 - You wanna some help ? :-D"+EOL$
  132.   SendNetworkData(ClientID, @a$, Len(a$))
  133. Return
  134.  
  135.  
  136. Command_LIST:
  137.   a$ = "150 - Opening connection"+EOL$
  138.   SendNetworkData(ClientID, @a$, Len(a$))
  139.  
  140.   If OpenNetworkConnection(ClientIP, ClientPort)
  141.   
  142.     If ExamineDirectory(0, CurrentDirectory$, "*.*")
  143.       a$ = ""
  144.       NumberFiles = 0
  145.       Repeat
  146.         Type = NextDirectoryEntry()
  147.         
  148.         If Type = 1 : a$ = a$+"rwxr-xr-x 6 12545 512 Jan 23 10:18 " +DirectoryEntryName()+EOL$ : EndIf
  149.         If Type = 2 : a$ = a$+"drwxr-xr-x 6 12545 512 Jan 23 10:18 "+DirectoryEntryName()+EOL$ : EndIf
  150.         
  151.         NumberFiles+1
  152.       Until Type = 0
  153.     EndIf
  154.     
  155.     a$ = "total "+Str(NumberFiles)+EOL$+a$
  156.     SendNetworkData(0, @a$, Len(a$))
  157.     CloseNetworkConnection()
  158.   EndIf
  159.  
  160.   a$ = "226 - Listing finished"+EOL$
  161.   SendNetworkData(ClientID, @a$, Len(a$))
  162. Return
  163.  
  164.  
  165. Command_PASS:
  166.   a$ = "230 - Welcome, enjoy this FTP site"+EOL$
  167.   SendNetworkData(ClientID, @a$, Len(a$))
  168. Return
  169.  
  170.  
  171. Command_PORT:
  172.   a$ = "200 - Ok"+EOL$
  173.  
  174.   ; Build a real IP
  175.   ;
  176.   Position = FindString(Argument$, ",", 1) 
  177.   ClientIP.s = ClientIP+Mid(Argument$, 1, Position-1)+"."
  178.  
  179.   NewPosition = FindString(Argument$, ",", Position+1)
  180.   ClientIP = ClientIP+Mid(Argument$, Position+1, NewPosition-Position-1)+"."
  181.  
  182.   Position = FindString(Argument$, ",", NewPosition+1)
  183.   ClientIP = ClientIP+Mid(Argument$, NewPosition+1, Position-NewPosition-1)+"."
  184.  
  185.   NewPosition = FindString(Argument$, ",", Position+1)
  186.   ClientIP = ClientIP+Mid(Argument$, Position+1, NewPosition-Position-1)
  187.  
  188.   ClientIP = StripLead(StripTrail(ClientIP))
  189.  
  190.   ; Get the port..
  191.   ;
  192.   Position = FindString(Argument$, ",", NewPosition+1)
  193.   ClientPort = Val(Mid(Argument$, NewPosition+1, Position-NewPosition-1)) << 8+Val(Right(Argument$, Len(Argument$)-Position))
  194.  
  195.   SendNetworkData(ClientID, @a$, Len(a$))
  196. Return
  197.  
  198.  
  199. Command_PWD:
  200.   a$ = "257 /"+EOL$
  201.   SendNetworkData(ClientID, @a$, Len(a$))
  202. Return
  203.  
  204.  
  205. Command_UNKNOWN:
  206.   a$ = "500 - Unknow command"+EOL$
  207.   SendNetworkData(ClientID, @a$, Len(a$))
  208. Return
  209.  
  210.  
  211. Command_USER:
  212.   If Argument$ = "anonymous"
  213.     a$ = "331 - User anonymous accepted. Please enter your e-mail"+EOL$
  214.   Else
  215.     a$ = "331 - Hello "+Argument$+". Please enter your password"+EOL$
  216.   EndIf
  217.  
  218.   SendNetworkData(ClientID, @a$, Len(a$))
  219. Return
  220.  
  221.  
  222. Command_SYST:
  223.   a$ = "215 - Atomic FTP Server v0.1"+EOL$
  224.   SendNetworkData(ClientID, @a$, Len(a$))
  225. Return
  226. ; ExecutableFormat=Windows
  227. ; Executable=C:\Atomic FTP Server.exe